TOS Silver 2000

home *** CD-ROM | disk | FTP | other *** search

/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / COMP / COMPIO.ICL < prev next >

Wrap

Text File | 1994-06-08 | 54.6 KB | 3 lines

⓪ ⓪ (* -----------------------------------------------------⓪#Modula Compiler /4.0 / fuer Atari V#144⓪#-----------------------------------------------------⓪ ⓪#File mc2: Input/Output Routinen⓪ ⓪#29. 9.85 hey Anpassung an GDOS 1.3⓪#17.10.85 Konstante PhysBlk1 gibt Anzahl Header-Blocks in Textfiles an;⓪2Auswertung von AutoCommand, ErrorFile⓪#20.10.85 Auswahl des Textfiles durch FileSelect⓪#21.02.86 mehr Platz reserviert in LoadDef⓪#22.02.86 Neuordnung der Texte⓪#26.02.86 ESC bei CodeOutputVol-Angabe bricht ab;⓪2CodeName nach Run-Command ohne Suffix uebergeben;⓪2Ruecksetzen von CnSufx und DnSufx fuer jede CompUnit neu⓪2(zur Tarnung in Clockstart!)⓪#27.02.86 Textnamen an Editor ohne Suffix uebergeben⓪#05.03.86 Default CodeVolume mit Namesplit gewinnen (GetSource);⓪2'.Text' als Default Suffix fuer Textfiles (OpFile)⓪3und Protokollfiles (OpenProt);⓪2Suche nach Textfiles beim Oeffnen (Open).⓪#07.03.86 TT myfnlen auf 81, zwei mal statt LSL.W # 5 -> MULU #mylnlen+1⓪#23.03.86 TT '...what text' -> '...which text'⓪#15.04.86 Text- und Definitionsmodule werden ReadOnly geoeffnet⓪#24.10.86 TT 8 Byte-Header wird nicht mehr erzeugt⓪#30.10.86 symbolische Fehlernummern, SyntaxErr nimmt negative⓪2Nummern MOD 256⓪#03.02.87 TT MOVEM-Listen geändert und mehr...⓪#30.03.87 TT Stop bei IO-Error, wenn keine Shell da; Include-Namen⓪2werden vollst. gerettet (80 Zeichen); Stripoptions korrig;⓪2ARGCV nicht mehr importiert.⓪#08.05.87 TT Warning-Funktion impl.; RELOAD korrigiert pTxt...; FetchLine⓪2neu; Variablen-Protokoll (alles aus 'GepardIO')⓪#24.05.87 TT 'TextName' wird bei include/exclude aktualisiert⓪#26.06.87 TT In Loaddef wird Dadr nicht mehr verändert, da schon in InitImp⓪2gesetzt.⓪#01.07.87 TT IOERR zeigt Dateinamen an, OPEN sucht Dateien.⓪#04.07.87 in Fehlermeldungen wird für '#' die StringVar 'BadID'⓪4substituiert; neue VAR BadID⓪#18.07.87 TT Verschiedene Pathlisten für Impl/Defn/Source; bei 'OPEN'⓪2wird immer gesucht, auch der Sourcename; Date/Time-Ausgaben⓪2wieder drin; Default Output-Volume ist immer erster Path⓪2in den Pathlists; Options mit '-' statt ';', '-O' für⓪2outVol-Bestimmung.⓪#30.08.87 TT c/i/dnSufx-Werte werden aus ShellMsg-Vars geholt⓪#27.10.87 jm Atari: LoadDef erwartet und prüft Namensfeld im DefModul⓪3(ab DefLayout 4)⓪#03.11.87 TT Uses-Option geht wieder (makeName: D0-Abfrage erw.)⓪#16.11.87 jm Auswertung von -Q als Kommandooption (= $Q+) ist⓪3schon drin (woher bloß?)!⓪2Übergabe von Zeile/Spalte an Editor vorbereitet:⓪3Zeile wird in TxtLine gezählt und bei Include gerettet;⓪3Spalte wird aus Textpos. (A2) und pTxtLin-Pointer⓪3errechnet und nach TxtCol geschrieben (ErrorEntry).⓪3Zeile und Spalte zählt ab Eins!⓪2Vor dem Buffer (BufDummy) steht jetzt CR & LF⓪3(erlaubt einheitliches Berechnen der SpaltenNr)⓪#17.11.87 jm Ausgabe der Seriennummer⓪#15.12.87 jm Seriennummer jetzt mit SerLead-Kennung⓪#22.12.87 TT Text-I/O über FileBase statt TextWindows, Ausgaberoutinen⓪3aus ConstEx hierher geholt⓪#03.01.88 TT ForceAsk-Variable, damit kein infinite scanning⓪#16.01.88 TT ProtLine kommt wieder mit zu grossen Zeilen klar.⓪#09.04.88 TT Meldung, wenn 68020 Assembler.⓪#15.05.88 TT In Definitionsmodulen sind wieder REAL-Consts möglich⓪2(LoadDef prüft nur unteres Nibble v. Modulkennung).⓪#02.06.88 TT Compiler kann Text auch im RAM übergeben werden. Dann sind⓪2includes nicht erlaubt (Abbruch mit Exitcode=4). (Siehe⓪2Var. 'fileMode').⓪#03.07.88 TT LibFiles verwendet; "Illg. Pointer-Var" in TextWindows⓪2kommt nicht mehr bei Comp-Start (Window wurde nicht bei⓪2TermProcess richtig geschlossen)⓪#05.07.88 TT LibFiles in Conditionals⓪#14.07.88 TT closeIO-Aufruf nun über ProcessTerm⓪#15.12.88 jm ProtID (wie ProtVar, aber nur ID-Ausgabe. Kann alle⓪4benamsten IDs aus dem Baum verarbeiten)⓪#01.01.89 Versionsabgleich TT - jm, Version 3.6j⓪#13.05.89 TT $U-Option überarbeitet - hat nun auch Vorrang vor Library⓪#12.07.89 TT InOutBase.CloseWdw wird nur noch einmal am Ende aufgerufen.⓪#25.07.89 TT GetNextLine f. singleLineMode neu; StripOptions verändert:⓪4Optionen werden nun mit '-', '+' o. '/' eingeleitet.⓪4'/L<name>' bestimmt nun Library.⓪#09.08.89 TT Sourcename wird auch bei Text im RAM in den Code übernommen⓪#19.08.89 TT DefLibName wird nicht gesucht; aus ShellMsg importiert.⓪#16.09.89 TT Def-Module werden ggf. dekomprimiert.⓪#20.06.90 TT SyntaxErr zeigt nun immer auf Beginn des zuletzt⓪2geholten Symbols⓪#09.07.90 TT 1/3 Größe des Textpuffers in der Konstante 'blocklen'; nun⓪2werden immer zwei Drittel des Puffers verschoben und nur⓪2jeweils eins nachgeladen.⓪#18.08.90 TT ShellPath wird ggf. bei Protfile eingesetzt⓪#13.09.90 TT UseFormat wird nun auch bei Übergabe in Cmdline ausgewertet;⓪2Wird der gesamte Options-Wert als Long übergeben, wird⓪2IMMER UseFormat gesetzt, d.h, diese Übergabeform ist nicht⓪2allg. anwendbar, weil normalerweise UseFormat unberührt⓪2bleibt, solange kein $F vorkommt.⓪#09.11.90 TT IEEE-Format nun mit "/F" in Cmdline bestimmbar⓪#15.03.91 TT "source lines" werden nun nicht mehr zu kurz ausgegeben.⓪#14.07.91 TT ID-Stack-Größe per Option "/In" festlegbar. Default: 2KB⓪#-----------------------------------------------------⓪ *)⓪ ⓪ ⓪ CONST⓪&fnlen = 80; (* Laenge von FileName-Strings an GDOS *)⓪$myfnlen = 80; (* Laenge der FileNames auf FNStack *)⓪#blocklen = 1024; (* Ein Drittel des Textpuffers in Byte *)⓪ ⓪"txtLSize = 264;⓪ ⓪ TYPE Str132 = ARRAY [0..txtLSize-1] OF CHAR;⓪%Str127 = ARRAY [0..126] OF CHAR;⓪ ⓪%tLinePtr = POINTER TO CHAR;⓪%LinePtrProc = PROCEDURE (): tLinePtr;⓪ ⓪ VAR⓪&bufferStart: ADDRESS;⓪(bufferRes: ADDRESS;⓪)doOutput: BOOLEAN; (* FALSE: Keinen Bildschirm I/O ! *)⓪)fileMode: BOOLEAN; (* FALSE: Text im RAM v. Editor übergeben *)⓪#singleLineMode: BOOLEAN; (* TRUE: Zeilen sind von außen verkettet *)⓪#singleLineProc: LinePtrProc;⓪ ⓪ (*⓪)bufDummy: word; (* TextBuffer; Dummy fuer fuehrendes CR *)⓪+buffer: ARRAY [0..$1FF] OF word;⓪*buffer1: ARRAY [0..$1FF] OF word;⓪+bufres: ARRAY [0..$1FF] OF word;⓪+bufend: word; (* muss bleiben ! Hält normlwse. EOF ! *)⓪ *)⓪ ⓪-eot : BOOLEAN;⓪,flen, (* dieser Wert muß global erhalten bleiben! *)⓪+flen3, (* lokaler Wert *)⓪+flen2 : LONGCARD; (* lokaler Wert *)⓪*byread : LONGCARD;⓪ ⓪'⓪'tmpOutVol,⓪*outVol,⓪'srcVolume, (* source input volume *)⓪&implVolume, (* impl output volume *)⓪'modVolume, (* code output volume *)⓪&defnvolume: String; (* defn output volume *)⓪&usesVolume: String; (* volume, wenn $U-Option verwendet *)⓪)useSufx, (* Suffix v. $E-Option *)⓪*dnSufx, (* Suffix fuer DefModule *)⓪*inSufx, (* Suffix fuer ImpModule *)⓪*cnSufx: ARRAY [0..3] OF CHAR;(* Suffix für PrgModule mit 0C am Ende!*)⓪ ⓪+pfile, (* protfile *)⓪+dfile, (* defn/codefile *)⓪+tfile: File; (* textfile *)⓪ ⓪-lib: BOOLEAN;⓪*deflib: LibFiles.LibFile;⓪(libentry: LibFiles.LibEntry;⓪)codebeg,⓪)codeend: address; (* ZW end of codefile *)⓪*txtptr: address; (* ZW fuer A2 *)⓪,dend, (* ZW EndAdr des DefModul *)⓪,dadr: address; (* ZW LadeAdr fuer DefModul *)⓪ ⓪(questVol,⓪(ForceAsk,⓪'OpenError: boolean; (* ZW fuer Open-Ergebnis *)⓪)⓪)fnstack: array [0..15] of string;⓪,fnsp: integer; (* filename stack pointer *)⓪)⓪%txtOfsStack: array [0..15] of LONGCARD;⓪%linenostack: array [0..15] of cardinal;⓪'linenoptr: integer; (* TextOffset / linenumber stack pointer *)⓪(⓪(inclevel: cardinal;⓪)inclptr: address;⓪)inclstk: array [0..31] of word;⓪)⓪)foundit: boolean; (* Ergebnis von FileSearch *)⓪+paths: PathList;⓪)⓪'outoptstr, (* String für Options-Ausgabe *)⓪)LineBuf: Str132; (* Eingaben v. Benutzer f. GetLine / ProtLine *)⓪*Comlin: POINTER TO Str127;⓪(startblk: cardinal; (* erster gebufferter Block *)⓪/c: char;⓪-ior: Integer; (* ZW fuer IOResult *)⓪ ⓪+pname, (* Name des ProtokollFiles *)⓪+cName, (* Name von Code/DefnModulen *)⓪*c2Name, (* Name von Code/DefnModulen *)⓪)libName, (* Name von Libdatei *)⓪%currentText: String; (* Name des gerade uebersetzten Files *)⓪'isInclude: boolean; (* Flag fuer Open *)⓪+csize: LONGCARD; (* Länge des erzeugten Codes *)⓪ ⓪*RelAdr: longcard; (* rel. Adresse im Protokoll *)⓪(pcolumns: cardinal; (* Anzahl Spalten fuer ProtokollFile *)⓪*nowStr: String; (* fuer Protokoll-Titel *)⓪)seconds: cardinal;⓪+Today: Date;⓪'StartTime,⓪(StopTime,⓪-Now: Time;⓪)⓪*strVal: BOOLEAN;⓪*strPos: CARDINAL;⓪+strP2: INTEGER;⓪)⓪/i: CARDINAL;⓪)⓪(IOResult: Integer;⓪ ⓪*errtxt: String;⓪.dr:CARDINAL;⓪ ⓪#debugProcAddr: ADDRESS;⓪(TreeBase,⓪'DisplaySP: LONGCARD;⓪&LoSysStack,⓪&HiSysStack: ADDRESS;⓪-wsp: MemArea;⓪(tCarrier: TermCarrier;⓪%secondEnter: BOOLEAN;⓪ ⓪ ⓪ (*$l-*)⓪ ⓪ VAR Errorfilename : String;⓪ ⓪ PROCEDURE Write(c:CHAR);⓪"BEGIN⓪$ASSEMBLER⓪&MOVE -(A3),D0⓪&TST doOutput⓪&BEQ noout⓪&MOVE D0,(A3)+⓪&MOVE.L InOutBase.Write,A0⓪&JMP (A0)⓪$noout⓪$END⓪"END Write;⓪ ⓪ PROCEDURE Read (VAR c:CHAR);⓪"BEGIN⓪$ASSEMBLER⓪&MOVE.L -(A3),D0⓪&TST doOutput⓪&BEQ noout⓪&MOVE.L D0,(A3)+⓪&MOVE.L InOutBase.Read,A0⓪&JMP (A0)⓪$noout⓪$END⓪"END Read;⓪ ⓪ PROCEDURE WriteLn;⓪"BEGIN⓪$ASSEMBLER⓪&TST doOutput⓪&BEQ noout⓪&MOVE.L InOutBase.WriteLn,A0⓪&JMP (A0)⓪$noout⓪$END⓪"END WriteLn;⓪ ⓪ PROCEDURE WriteString(c:ARRAY OF CHAR);⓪"BEGIN⓪$ASSEMBLER⓪&MOVE -(A3),D0⓪&MOVE.L -(A3),D1⓪&TST doOutput⓪&BEQ noout⓪&MOVE.L D1,(A3)+⓪&MOVE D0,(A3)+⓪&MOVE.L InOutBase.WriteString,A0⓪&JMP (A0)⓪$noout⓪$END⓪"END WriteString;⓪ ⓪ PROCEDURE ReadString(VAR c:ARRAY OF CHAR);⓪"BEGIN⓪$ASSEMBLER⓪&MOVE -(A3),D0⓪&MOVE.L -(A3),D1⓪&TST doOutput⓪&BEQ noout⓪&MOVE.L D1,(A3)+⓪&MOVE D0,(A3)+⓪&MOVE.L InOutBase.ReadString,A0⓪&JMP (A0)⓪$noout⓪$END⓪"END ReadString;⓪ ⓪ ⓪ (*$l+ === Zuerst die reinen Modula-Prozeduren *)⓪ ⓪ PROCEDURE writeLCard (lc:Longcard; n:CARDINAL);⓪"BEGIN⓪$WriteString (CardToStr(lc,n))⓪"END writeLCard;⓪ ⓪ PROCEDURE conc (a,b:ARRAY OF CHAR):String;⓪"VAR c:String;⓪"BEGIN⓪$FastStrings.Concat (a,b,c);⓪$RETURN c⓪"END conc;⓪ ⓪ PROCEDURE cop (VAR a:ARRAY OF CHAR; p,l:CARDINAL):Str132;⓪"VAR c:Str132;⓪"BEGIN⓪$FastStrings.Copy (a,p,l,c);⓪$RETURN c⓪"END cop;⓪ ⓪ PROCEDURE StripOptions (VAR s: ARRAY OF CHAR; init: BOOLEAN);⓪ ⓪"(* Optionen im String suchen, entfernen und auswerten⓪#*⓪#* 'init' = TRUE: Aufruf ganz zu Beginn, z.B. für '/'-Optionen⓪#*⓪#* Alle Options werden mit einem Leerzeichen und dann +, - oder /⓪#* eingeleitet.⓪#* Options mit '-' oder '+' werden genau auf die entsprechenden⓪#* Meta-Commands im Source (*$..*) abgebildet,⓪#* andere beginnen mit '/'.⓪#* '/<Zahl>' übernimmt den Wert in das OPTIONS-Longword⓪#*)⓪ ⓪"VAR ch, modeCh,⓪+optCh: char;⓪'optString: String;⓪'wordStart,⓪/p: cardinal;⓪-eol: BOOLEAN;⓪/l: LONGCARD;⓪ ⓪"PROCEDURE getCh (): BOOLEAN;⓪$BEGIN⓪&IF p > HIGH (s) THEN⓪(eol:= TRUE⓪&ELSIF NOT eol THEN⓪(ch:= s[p];⓪(INC (p);⓪(eol:= ch = 0C⓪&END;⓪&RETURN NOT eol⓪$END getCh;⓪ ⓪"PROCEDURE getNoSpc (): BOOLEAN;⓪$BEGIN⓪&RETURN getCh () AND (ch > ' ');⓪$END getNoSpc;⓪ ⓪"PROCEDURE getSpc (): BOOLEAN;⓪$BEGIN⓪&RETURN getCh () AND (ch <= ' ');⓪$END getSpc;⓪ ⓪"PROCEDURE getWord ();⓪$BEGIN⓪&optString:= '';⓪&WHILE getNoSpc () DO⓪(FastStrings.Append (ch, optString);⓪&END;⓪$END getWord;⓪"⓪"PROCEDURE optstrout (REF s: ARRAY OF CHAR);⓪$BEGIN⓪&FastStrings.Append (' ', outoptstr);⓪&FastStrings.Append (s, outoptstr);⓪&FastStrings.Append (optString, outoptstr);⓪$END optstrout;⓪$⓪"BEGIN⓪$eol:= FALSE;⓪$p:= 0;⓪$LOOP⓪&REPEAT wordStart:= p UNTIL NOT getSpc ();⓪&IF eol THEN EXIT END;⓪&modeCh:= ch;⓪&getWord;⓪&IF (modeCh = "/") OR⓪&(NOT init AND ((modeCh = '-') OR (modeCh = '+')) ) THEN⓪(FastStrings.Delete (s, wordStart, p-wordStart);⓪(p:= wordStart;⓪(OptCh := cap (optString[0]);⓪(IF modeCh = '+' THEN⓪*IF OptCh # 'Q' THEN optstrout ('+') END;⓪*ASSEMBLER⓪0MOVE.B optCh(A6),D1⓪0SUBI.B #64,D1⓪0BCS ign⓪0CMPI.B #31,D1⓪0BHI ign⓪0CMPI.B #6,D1⓪0BNE noF⓪0; Bei +F UseFormat auf IEEE setzen⓪0MOVE #1,GlobalUseFormat⓪.noF⓪0MOVE.L OptToSetVar,D0⓪0BSET D1,D0⓪0MOVE.L D0,OptToSetVar⓪.ign⓪*END⓪(ELSIF modeCh = '-' THEN⓪*optstrout ('-');⓪*ASSEMBLER⓪0MOVE.B optCh(A6),D1⓪0SUBI.B #64,D1⓪0BCS ign2⓪0CMPI.B #31,D1⓪0BHI ign2⓪0CMPI.B #6,D1⓪0BNE noF2⓪0; Bei -F UseFormat auf MM2 setzen⓪0CLR GlobalUseFormat⓪.noF2⓪0MOVE.L OptToSetVar,D0⓪0MOVE.L OptToClrVar,D2⓪0BCLR D1,D0⓪0BCLR D1,D2⓪0MOVE.L D0,OptToSetVar⓪0MOVE.L D2,OptToClrVar⓪.ign2⓪*END⓪(ELSE⓪*(* Option mit '/' *)⓪*Delete (optstring, 0, 1, strVal);⓪*IF optCh='F' THEN (* IEEE-Format *)⓪,optstrout ('/F');⓪,GlobalUseFormat:= 2⓪*ELSIF optCh='A' THEN (* DATA-Puffergröße *)⓪,strPos:= 0;⓪,l:= StrToLCard (optString,strPos,strVal);⓪,IF l >= 100 THEN DataLen:= l END⓪*ELSIF optCh='>' THEN (* mind. freizuhaltender Speicher *)⓪,strPos:= 0;⓪,l:= StrToLCard (optString,strPos,strVal);⓪,IF l >= 8192 THEN DynSpace:= l END⓪*ELSIF optCh='<' THEN (* max. zu belegender Speicher *)⓪,strPos:= 0;⓪,l:= StrToLCard (optString,strPos,strVal);⓪,IF l >= 64000 THEN MaxSpace:= l END⓪*ELSIF optCh='D' THEN (* debug procedure *)⓪,GetProcAddr (optString, debugProcAddr);⓪*ELSIF optCh='S' THEN⓪,HaltOnError:= TRUE⓪*ELSIF optCh='O' THEN⓪,optstrout ('Out:');⓪,FastStrings.Assign (optString, outVol);⓪*ELSIF optCh='L' THEN⓪,optstrout ('Lib:');⓪,FastStrings.Assign (optString, libName)⓪*ELSIF optCh='P' THEN⓪,optstrout ('Prot:');⓪,IF length (OptString) # 0 THEN pname:= optString END;⓪,ProtFile:= true⓪*ELSIF optCh='C' THEN⓪,strPos:= 0;⓪,p:= StrToCard (optString,strPos,strVal);⓪,IF p >= 40 THEN pcolumns:= p END⓪*ELSIF optCh='I' THEN⓪,strPos:= 0;⓪,l:= StrToLCard (optString,strPos,strVal);⓪,IF l > 2000 THEN IDStkSize:= l END⓪*ELSIF init & (optCh='Q') THEN⓪,doOutput:= FALSE;⓪*ELSIF init & (optCh='@') THEN⓪,(* Textpuffer vom Gepard-Editor im RAM *)⓪,strPos:= 0;⓪,bufferStart:= StrToLCard (optString,strPos,strVal);⓪,bufferRes:= $7FFFFFFF;⓪,IF strVal THEN⓪.fileMode:= FALSE;⓪.singleLineMode:= FALSE;⓪,END⓪*ELSIF init & (optCh='^') THEN⓪,(* Text kommt zeilenweise *)⓪,strPos:= 0;⓪,singleLineProc:= LinePtrProc (StrToLCard (optString,strPos,strVal));⓪,IF strVal THEN⓪.bufferStart:= 3L;⓪.bufferRes:= $7FFFFFFF;⓪.singleLineMode:= TRUE;⓪.fileMode:= FALSE⓪,END;⓪*ELSE⓪,strPos:= 0;⓪,l:= StrToLCard (optString,strPos,strVal);⓪,IF strVal THEN⓪.(* '/<Zahl>': Options-Wert (f. Scanning) direkt übernehmen *)⓪.ASSEMBLER⓪0CLR.L OptToClrVar⓪0MOVE.L l(A6),D0⓪0MOVE.L D0,OptToSetVar⓪0; UseFormat auch setzen⓪0BTST #6,D0⓪0SNE D0⓪0ANDI #1,D0⓪0MOVE D0,GlobalUseFormat⓪.END⓪,END;⓪*END;⓪(END⓪&END;⓪$END;⓪"END StripOptions;⓪ ⓪ PROCEDURE showError (VAR s:ARRAY OF CHAR);⓪"BEGIN⓪$IF (debugProcAddr # NIL) OR (~Active AND doOutput) THEN⓪&WriteLn;⓪&WriteString (s);⓪&WriteLn;⓪&WriteString ('Press a key...');⓪&IF debugProcAddr # NIL THEN⓪(WriteString (" ('D' to debug)");⓪&END;⓪&Read (c);⓪&IF debugProcAddr # NIL THEN⓪(IF CAP (c) # 'D' THEN debugProcAddr:= NIL END⓪&END⓪$END;⓪"END showError;⓪ ⓪ PROCEDURE FindStr (REF text: ARRAY OF CHAR; start: ADDRESS; len: LONGCARD;⓪3VAR addr: ADDRESS): BOOLEAN;⓪"VAR found: BOOLEAN;⓪"BEGIN⓪$found:= FALSE;⓪$addr:= NIL;⓪$ASSEMBLER⓪(MOVE.L start(A6),A1⓪(MOVE.L len(A6),D1⓪(MOVE.L text(A6),A0⓪(MOVE.B (A0)+,D2⓪(BNE los⓪(BRA ende⓪%l1 SWAP D1⓪%l2 CMP.B (A1)+,D2⓪$los DBEQ D1,l2⓪(BEQ f1⓪(SWAP D1⓪(DBRA D1,l1⓪(BRA ende⓪%f1 MOVE.L A1,A2⓪(MOVE.W text+4(A6),D0⓪(BEQ hurra⓪(SUBQ #1,D0⓪%f2 MOVE.B (A0)+,D2⓪(BEQ hurra⓪(CMP.B (A1)+,D2⓪(DBNE D0,f2⓪(BEQ hurra⓪(MOVE.L A2,A1⓪(MOVE.L text(A6),A0⓪(MOVE.B (A0)+,D2⓪(BRA los⓪&hurra⓪(MOVE.L start(A6),A0⓪(ADDA.L len(A6),A0⓪(CMPA.L A0,A1⓪(BHI ende⓪(ADDQ #1,found(A6)⓪(MOVE.L addr(A6),A0⓪(SUBQ.L #1,A2⓪(MOVE.L A2,(A0)⓪&ende⓪$END;⓪$RETURN found⓪"END FindStr;⓪"⓪ ⓪ (*$l- === Ab hier nur noch Link Off ! *)⓪ ⓪ ⓪ PROCEDURE ioerr;⓪#(* mit IO Error abbrechen; Fehler in ior *)⓪ BEGIN⓪"ASSEMBLER⓪(MOVE.L EVALSTK,A3⓪"END;⓪"Files.GetStateMsg (ior,errtxt);⓪"ErrorMsg := conc ('I/O error: ',errtxt);⓪"foundit:=FALSE;⓪"IF State (tfile)<0 THEN⓪$errtxt:=CurrentText;⓪$foundit:=TRUE⓪"ELSIF State (dfile)<0 THEN⓪$Files.GetFileName (dfile,errtxt);⓪$IF errtxt[0] = 0C THEN⓪&FastStrings.Assign (cname, errtxt)⓪$END;⓪$foundit:=TRUE⓪"END;⓪"IF foundit & (errtxt[0] # 0C) THEN⓪$ErrorMsg:= conc (ErrorMsg,conc (', File: ',errtxt))⓪"END;⓪"Files.ResetState (tfile);⓪"Files.Close (tfile);⓪"Files.ResetState (dfile);⓪"Files.Remove (dfile);⓪"showError (ErrorMsg);⓪"TermProcess (2);⓪ END ioerr;⓪ ⓪ ⓪ PROCEDURE FetchLine;⓪"(* holt Zeile von (A2)+ nach (A0), ohne führende Spaces⓪%markiert Zeichen invers, wenn A2=D3⓪%A0 = ^Destination⓪%D2 = maximale Laenge (Abbruch nach Ueberschreiten)⓪%(A2,D0,D1)⓪"*)⓪ BEGIN ASSEMBLER⓪(CLR D1⓪(SUBQ #5,D2 ; wg. Ctrl-Zeichen⓪ !PF5 MOVE.B (A2)+,D0⓪(BEQ pf4⓪(CMPI.B #SPC,D0⓪(BEQ PF5 ;fuehrende Spaces weg⓪(CMPI.B #DLE,D0⓪(BNE PF1⓪(MOVE.B (A2)+,D0⓪(SUBI.B #$20+2,D0⓪(EXT.W D0⓪(ADD.W D0,TextCol ; TextCol bei DLE korrigieren⓪(BRA PF5⓪ pf4 TST.W singleLineMode⓪(BEQ pf5⓪(BRA pf2⓪ Pf1 CMPI.B #$D,D0⓪(BEQ PF2⓪(CMPA.L D3,A2⓪(BNE noMark⓪(MOVE.B #27,(A0)+⓪(MOVE.B #'p',(A0)+⓪(MOVE.B D0,(A0)+⓪(MOVE.B #27,(A0)+⓪(MOVE.B #'q',(A0)+⓪(ADDQ.W #5,D1⓪(BRA PF0⓪ noMark MOVE.B D0,(A0)+⓪(ADDQ.W #1,D1⓪ PF0 MOVE.B (A2)+,D0⓪(CMP D2,D1⓪(BCS PF1 ;D1 < D2⓪ !PF2 CMPA.L D3,A2⓪(BNE noMark2⓪(MOVE.B #27,(A0)+⓪(MOVE.B #'p',(A0)+⓪(MOVE.B D0,(A0)+⓪(MOVE.B #27,(A0)+⓪(MOVE.B #'q',(A0)+⓪ noMark2 CLR.B (A0)+⓪&END⓪ END FetchLine;⓪ ⓪ ⓪ PROCEDURE ErrorEntry;⓪"BEGIN⓪$ASSEMBLER⓪(; A1 & A6 hier nicht zerstören!⓪(MOVE.L A1,TreeBase⓪(MOVE.L A6,DisplaySP⓪(⓪(CMPI #rEOInp,D5⓪(BNE noComm⓪(TST.W cmtLine⓪(BEQ noComm⓪(⓪(MOVE.W cmtCol,TextCol⓪(MOVE cmtLine,TextLine⓪(CLR.B errTxt⓪(BRA.W cont⓪(⓪ noComm TST.B DoingAsm⓪(BEQ noAsm⓪(⓪(MOVE.B OprndCnt,D3⓪(SUBQ.B #1,D3⓪(BCS mne⓪(BEQ op1⓪(SUBQ.B #1,D3⓪(BEQ op2⓪(MOVE.L pTxtOp3,A2 ; Text-^ für Operand 3⓪(BRA warn⓪ op2 MOVE.L pTxtOp2,A2 ; Text-^ für Operand 2⓪(BRA warn⓪ op1 MOVE.L pTxtOp1,A2 ; Text-^ für Operand 1⓪(BRA warn⓪ mne MOVE.L pTxtMne,A2 ; Text-^ für Mnemonic⓪ warn MOVE.L A2,pLastSym⓪(MOVE.L pTxtLin2,pTxtLin⓪(MOVE.L TxtLine2,TxtLine⓪(⓪&noAsm⓪(; da A2 ggf. in die Pampa zeigt, nehmen wir nun immer den⓪(; letzten GetSbl-Ptr.⓪(MOVE.L pLastSym,A2⓪(⓪(MOVE.L A2,D1⓪(SUB.L pTxtLin,D1⓪(ADDQ #1,D1⓪(MOVE.W D1,TextCol⓪(MOVE TxtLine,TextLine⓪(⓪(MOVE.L A2,D3 ; Textpos. des Fehlers⓪(ADDQ.L #1,D3⓪(MOVE.L pTxtLin,A2 ; hier steht die Zeile⓪(LEA errTxt,A0 ; hier soll sie hin⓪(MOVEQ #75,D2 ; höchstens 75 Zeichen holen⓪(JSR fetchLine ; ! Korrgiert ggf. TextCol, wenn DLE drin⓪(⓪&cont⓪(TST TextCol⓪(BGT nnull⓪&null⓪(MOVE.W #1,TextCol⓪&nnull⓪$END⓪"END ErrorEntry;⓪ ⓪ (*⓪ PROCEDURE getNumb (var i:Convert.GetInfo);⓪"BEGIN⓪$ASSEMBLER⓪(MOVE.L -(A3),A1⓪(SUBQ.L #1,byread⓪(BPL cont⓪(CLR.B Convert.Getinfo.ch(A1)⓪(RTS⓪&cont⓪(MOVE.L code,A0⓪(MOVE.B (A0)+,Convert.Getinfo.ch(A1)⓪(ADDQ.L #1,code⓪$END⓪"END getNumb;⓪ *)⓪ ⓪ PROCEDURE syntaxerr;⓪#(* Fehler ans System melden,⓪&FehlerNr in D5 *)⓪ BEGIN⓪"ASSEMBLER⓪(TST.W D5⓪(BPL isPos⓪(AND.W #255,D5⓪&isPos⓪(MOVE.W D5,errornr⓪(⓪(TAS secondEnter⓪(BNE is2⓪(JSR ErrorEntry⓪((* der VerifyWholeTree-Aufruf sollte feststellen, ob der akt. Fehler⓪)* wg. eines Fehlers im Baum auftrat. Das geht leider nicht so einfach,⓪)* weil u.U. der Fehler gemeldet wird, während gerade ein neuer⓪)* ID eingetragen wird, aber noch nicht vollst. ausgefüllt wurde.⓪)* Dann steht u.U. noch Müll drin.⓪(CMPI #rTree,errornr⓪(BEQ is2⓪(JSR VerifyWholeTree⓪(*)⓪#is2: MOVE.L EVALSTK,A3⓪"END;⓪"Files.ResetState (tfile);⓪"Files.Close (tfile);⓪"Files.ResetState (dfile);⓪"Files.Remove (dfile);⓪"IF ErrorNr # 0 THEN⓪$(* kein scanning *)⓪$⓪$IF debugProcAddr # NIL THEN⓪&Write (27C); Write ('E'); (* clr scrn *)⓪$END;⓪$⓪$writeln; writeln;⓪$writestring (errTxt);⓪$writeln;⓪$⓪$(* Fehlermsg suchen in ErrorMsg-Datei *)⓪$dr:=0;⓪$⓪$SearchFile (ErrListFile,SrcPaths,fromStart,foundit,errtxt);⓪$Files.Open (tfile,errtxt,readOnly);⓪$IF State (tfile) >= 0 THEN⓪&ReadBytes (tfile,Header,symtre-Header,byread);⓪&Files.close (tfile);⓪$ELSE⓪&byread:= 0⓪$END;⓪$errtxt:= CardToStr (errornr,0);⓪$FastStrings.Append (':', errtxt);⓪$(* Suche nach "<errno>:" *)⓪$IF (byread # 0L) & (FindStr (errtxt, Header, byread, comlin)) THEN⓪&FastStrings.Assign (comlin^, errtxt);⓪&strP2:= Pos (CHR(13), errtxt, 0);⓪&IF strP2 >= 0 THEN errtxt[strP2]:= 0C END;⓪&Delete (errtxt, 0, Pos (':', errtxt, 0)+2, strVal); (* ': ' löschen *)⓪&FastStrings.Assign (errTxt,errormsg);⓪$ELSE⓪&errormsg := conc ('Compile error ', CardToStr (errornr,0))⓪$END;⓪$IF BadId [0] # 0C THEN⓪&strP2 := pos ('#', ErrorMsg, 0);⓪&IF strP2 >= 0 THEN⓪(Delete (ErrorMsg, strP2, 1, strVal);⓪(FastStrings.Insert (BadID, strP2, ErrorMsg)⓪&ELSE⓪(FastStrings.Append (' (', ErrorMsg);⓪(FastStrings.Append (BadId, ErrorMsg);⓪(FastStrings.Append (')', ErrorMsg);⓪&END;⓪$END;⓪$⓪$IF (debugProcAddr # NIL) OR ~Active THEN⓪&errormsg := conc (errormsg,conc (' in line ', CardToStr (TxtLine,0)) );⓪&errormsg := conc (errormsg,conc (', column ', CardToStr (TextCol,0)) );⓪$END;⓪$⓪$IF ProtFile THEN⓪&Text.writeln (pfile);⓪&Text.writestring (pfile, '>>> ');⓪&Text.writestring (pfile, errormsg);⓪&Text.writeln (pfile);⓪&Files.Close (pfile);⓪&ProtFile := false⓪$END;⓪$⓪$showError (ErrorMsg);⓪$⓪$IF debugProcAddr # NIL THEN⓪&ASSEMBLER⓪(MOVE.L TreeBase,A1⓪(MOVE.L DisplaySP,A0⓪(MOVE.L RStkPtr,D0⓪(MOVE.L debugProcAddr,A2⓪(JSR (A2)⓪&END⓪$END;⓪$⓪$TermProcess (3)⓪"ELSE⓪$TermProcess (0) (* Scan erfolgreich *)⓪"END⓪ END syntaxerr;⓪ ⓪ ⓪ PROCEDURE crout;⓪"(* CR ausgeben *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L A0-A6/D1-D7,-(A7)⓪(MOVE.L EVALSTK,A3⓪(JSR WRITELN⓪(MOVEM.L (A7)+,A0-A6/D1-D7⓪&END⓪ END crout;⓪(⓪(⓪ PROCEDURE byteout;⓪#(* D0 als ASCII ausgeben *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪(MOVE.B D0,(A3)+⓪(ADDQ.L #1,A3⓪(JSR WRITE⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END byteout;⓪ ⓪ PROCEDURE prtlong;⓪#(* D1.long dezimal ausgeben *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪(MOVE.L D1,(A3)+⓪(MOVE.W #7,(A3)+⓪(JSR WRITELCARD⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END prtlong;⓪ ⓪ PROCEDURE PRTSPC;⓪ BEGIN⓪ ASSEMBLER⓪%MOVEQ #SPC,D0⓪%JMP BYTEOUT⓪ END⓪ END PRTSPC;⓪ ⓪ PROCEDURE strout;⓪#(* String in A0 ausgeben, MaxLen vorher in D0, danach Len in D0 *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-D2/A1-A2,-(A7)⓪(MOVE.L EVALSTK,A3⓪(CLR D1⓪(MOVE.L A0,-(A7)⓪ ERR02 CMP D1,D0⓪(BEQ ERR01⓪(TST.B (A0)+⓪(BEQ ERR01⓪(ADDQ #1,D1⓪(BRA ERR02⓪ ERR01 MOVE.L (A7),D2⓪(MOVE.L D2,(A3)+⓪(SUBA.L D2,A0⓪(MOVE.W A0,-(A7)⓪(TST D1⓪(BEQ E3⓪(SUBQ #1,D1⓪ E3 MOVE.W D1,(A3)+⓪(JSR WriteString⓪(MOVE.W (A7)+,D0⓪(MOVE.L (A7)+,A0⓪(MOVEM.L (A7)+,D1/D2/A1/A2⓪&END⓪ END strout;⓪ ⓪ ⓪ VAR DECNUM: ARRAY [0..5] OF CHAR;⓪ ⓪ PROCEDURE PRTDEC;⓪ BEGIN⓪ ASSEMBLER⓪)LEA DECNUM,A0⓪)MOVE.L #$20202020,(A0)⓪)MOVE.W #$2000,4(A0)⓪)MOVEQ #4,D2⓪ !PRTDEC1 DIVU #10,D1⓪)SWAP D1⓪)ORI.B #'0',D1⓪)MOVE.B D1,0(A0,D2.W)⓪)CLR.W D1⓪)SWAP D1⓪)DBEQ D2,PRTDEC1⓪)MOVEQ #-1,D0⓪)JMP strout⓪ END⓪ END PRTDEC;⓪ ⓪ ⓪ PROCEDURE ERR;⓪ BEGIN⓪ ASSEMBLER⓪)JSR CROUT⓪)JSR CROUT⓪)JMP PRTSTR⓪ END⓪ END ERR;⓪ ⓪ ⓪ PROCEDURE PRTSTR;⓪ BEGIN ASSEMBLER⓪(MOVE.L (A7)+,A0⓪(MOVEQ #-1,D0⓪(JSR strOut⓪(ADDA.W D0,A0⓪(MOVE.W A0,D1⓪(BTST #0,D1⓪(BEQ ERR03⓪(ADDQ.L #1,A0⓪ ERR03 MOVE.L A0,-(A7)⓪&END⓪ END PRTSTR;⓪ ⓪ PROCEDURE PRTID;⓪ BEGIN⓪ ASSEMBLER⓪)MOVE.W OPTIONS,D0⓪)BTST #1,D0 ;Q⓪)BNE PRTID4 ;QUIET COMPILE⓪)JSR CROUT⓪)MOVEQ #14,D0⓪)JSR strout⓪)SUB #15,D0⓪)NEG D0⓪)LEA spcs(PC),A0⓪)JSR strout⓪)MOVEQ #'/',D0⓪)JSR BYTEOUT⓪)MOVE.L A1,D1⓪)ADD.L TRESPC,D1⓪)SUB.L A4,D1⓪)JSR PRTLONG⓪)JSR PRTSTR⓪)ACZ ' bytes/'⓪)SYNC⓪)JSR CROUT⓪)MOVEQ #'<',D0⓪)JSR BYTEOUT⓪)CLR.L D1⓪)MOVE.W LINE,D1⓪)JSR PRTDEC⓪)MOVEQ #'>',D0⓪)JMP BYTEOUT⓪ spcs ASC ' '⓪ !PRTID4⓪ END⓪ END PRTID;⓪ ⓪ ⓪ PROCEDURE SUELZ;⓪ BEGIN⓪ ASSEMBLER⓪)JSR CROUT⓪)JSR CROUT⓪)JSR PRTSPC⓪)CLR.L D1⓪)MOVE.W LINE,D1⓪)JSR PRTDEC⓪)JSR PRTSTR⓪)ACZ ' source lines, '⓪)SYNC⓪)MOVE.L A4,D1⓪)SUB.L Header,D1⓪)JSR PRTLONG⓪)JSR PRTSTR⓪)ACZ ' bytes of code'⓪)SYNC⓪)JMP CROUT⓪ END⓪ END SUELZ;⓪ ⓪ ⓪ PROCEDURE getfn;⓪#(* FileName vom FnStack nach (A5)+ bringen.⓪&FN bleibt auch auf FnStack!⓪&(D0,A0,A5)⓪#*)⓪ BEGIN ASSEMBLER⓪(MOVE.W FNsp,D0⓪(MULU #myfnlen,D0 ;FileName is xx byte lang!⓪(LEA FNSTACK,A0⓪(ADDA.W D0,A0⓪(MOVEQ #myfnlen-1,D0⓪ !LP MOVE.B (A0)+,(A5)+⓪(DBEQ D0,LP⓪&END⓪ END getfn;⓪ ⓪ ⓪ PROCEDURE pullfn;⓪#(* 'vergisst' FileName vom FnStack *)⓪ BEGIN⓪"dec (fnsp)⓪ END pullfn;⓪ ⓪(⓪ PROCEDURE FetchString;⓪"(* holt String von (A2)+ nach (A0),⓪%bricht bei Kommentarende ab!⓪%A0 = ^Destination⓪%D0 = zusaetzliches terminierendes Zeichen⓪%D2 = maximale Laenge (Abbruch nach Ueberschreiten)⓪%D1 := Laenge des Strings in char⓪%A2 := ^erstes nicht in den String uebernommenes Zeichen⓪%(D0, A2)⓪"*)⓪ BEGIN ASSEMBLER⓪(CLR.W D1⓪(MOVE.B D0,-(A7) ;termChar⓪ !PF5 MOVE.B (A2)+,D0⓪(CMPI.B #SPC,D0⓪(BEQ PF5 ;fuehrende Spaces weg⓪ !PF1 CMPI.B #SPC,D0⓪(BLS PF2 ;danach: spc/ctrl sind Endmarke⓪(CMPI.B #$FE,D0 ; ebenso $FE, $FF⓪(BCC PF2⓪(CMPI.B #',',D0 ; und "," auch⓪(BEQ PF2⓪(CMP.B (A7),D0 ; oder unser termChar⓪(BEQ PF2⓪(CMPI.B #'*',D0 ; oder '*' mit folg. ')'⓪(BNE PF4⓪(CMPI.B #')',(A2)⓪(BEQ PF2⓪ PF4 MOVE.B D0,0(A0,D1.W)⓪(ADDQ.W #1,D1⓪(MOVE.B (A2)+,D0⓪(CMP.B D2,D1⓪(BCS PF1 ;D1 < D2⓪ !PF2 CMP.B D2,D1⓪(BCC PF3 ;D1 >= D2⓪(CLR.B 0(A0,D1.W)⓪ PF3 SUBQ.L #1,A2⓪(ADDQ.L #2,A7⓪&END⓪ END FetchString;⓪ ⓪ PROCEDURE pushFN;⓪ (* holt FileName aus dem Text auf FnStack *)⓪ BEGIN ASSEMBLER⓪(MOVE.W FNsp,D0⓪(ADDQ.W #1,D0⓪(CMP.W #15,D0⓪(BLS OK⓪(MOVE #rIncOv,D5⓪(JMP SYNTAXERR⓪ !OK MOVE.W D0,FNsp⓪(MULU #myfnlen,D0 ;xx byte FileNames⓪(LEA FNSTACK,A0⓪(ADDA.W D0,A0 ;Adresse auf FnStack⓪(MOVEQ #myfnlen,D2 ; erlaubte Länge. Mit Path und Suffix⓪(CLR.W D0 ;kein Abbruchzeichen⓪(JSR FetchString⓪&END⓪ END pushFN;⓪ ⓪ PROCEDURE pullLineNo;⓪ BEGIN ASSEMBLER⓪(SUBQ #1,LineNoPTR⓪(MOVE.W LineNoPTR,D0⓪(ASL #1,D0⓪(LEA LineNoSTACK,A0⓪(MOVE 0(A0,D0.W),TxtLine⓪(ASL #1,D0⓪(LEA txtOfsStack,A0⓪(MOVE.L 0(A0,D0.W),TextOffset⓪&END⓪ END pullLineNo;⓪ ⓪ PROCEDURE pushLineNo;⓪ BEGIN ASSEMBLER⓪(MOVE.W lineNoPTR,D0⓪(ADDQ.W #1,D0⓪(CMP.W #15,D0⓪(BLS OK⓪(MOVE #rIncOv,D5⓪(JMP SYNTAXERR⓪ !OK MOVE.W D0,lineNoPTR⓪(SUBQ.W #1,D0⓪(ASL #1,D0⓪(LEA lineNoSTACK,A0⓪(MOVE TxtLine,0(A0,D0.W)⓪(CLR.W TxtLine⓪(ASL #1,D0⓪(LEA txtOfsStack,A0⓪(MOVE.L TextOffset,0(A0,D0.W)⓪(CLR.L TextOffset⓪&END⓪ END pushLineNo;⓪ ⓪ ⓪ PROCEDURE makename2;⓪#(* FileName von ID-Stack auf (A5).. bringen. (bleibt auf IDStack!)⓪&D5.B: Modul-Typ (bestimmt den Suffix) (D0/D1, A0/A5),⓪&ist D5.B=0, wird gesamter Name ohne Suffix kopiert,⓪&ist Bit 15 in D5 gesetzt, wird ggf. useSufx benutzt, sonst nicht *)⓪ BEGIN ASSEMBLER⓪(;Prefix wird nicht mehr kopiert!⓪(JSR LOOKID⓪(MOVEQ #8,D2⓪(TST.B D5⓪(BNE wSuf⓪(MOVEQ #80,D2⓪ wSuf MOVE.L A5,-(A7)⓪(CLR.W D0 ;Name kopieren⓪ !MN4 MOVE.B (A0)+,D1⓪(BEQ MN5⓪(MOVE.B D1,(A5)+⓪(ADDQ.B #1,D0⓪(CMP.B D2,D0⓪(BNE MN4⓪ !MN5 CLR.B (A5)⓪(TST.B D5⓪(BEQ noSuf⓪(MOVE.B #'.',(A5)+⓪(TST.W D5 ;Name f. csave?⓪(BPL noCsave⓪(TST.B useSufx ;dann ggf. $E-Option verwenden⓪(BNE eopt⓪ noCsave CMPI.B #3,D5 ;DefModul?⓪(BEQ MN6⓪(LEA INSUFX,A0⓪(CMPI.B #2,D5 ;ImpModul?⓪(BEQ MN8⓪(LEA CNSUFX,A0⓪(BRA MN8⓪ eopt LEA useSufx,A0⓪(BRA MN8⓪ !MN6 LEA DNSUFX,A0 ;Suffix kopieren⓪ !MN8 MOVE.B (A0)+,(A5)+⓪(BNE mn8⓪ nosuf MOVEA.L (A7)+,A5⓪"END⓪ END makename2;⓪ ⓪ ⓪ PROCEDURE close;⓪#(* Textfile schliessen, setzt Modula-Umgebung voraus *)⓪ BEGIN⓪"Files.ResetState (tfile);⓪"Files.Close (tfile);⓪"IOR := State (tfile);⓪"IF ior < 0 THEN⓪$ASSEMBLER⓪&MOVE.L A3,EVALSTK⓪&JMP IOERR⓪$END⓪"END⓪ END close;⓪ ⓪ ⓪ PROCEDURE Fread;⓪ BEGIN ASSEMBLER⓪(; D0: blocknr.⓪(MOVE.L D1,-(A7)⓪(CLR EOT⓪(MULU #blocklen,D0 ; Anzahl Zeichen zu lesen⓪(MOVE StartBlk,D1 ; 1. Block im Puffer⓪(ADDQ #3,D1 ; D1: letzter Block + 1⓪(MULU #blocklen,D1 ; Anzahl Zeichen, die inges. im File erwartet.⓪(SUB.L flen,D1 ; Ist sie größer/gleich als fileLength ?⓪(BCS noEof ; Nein⓪(; EOF-Flag setzen, verbleibende Länge auf Heap⓪(MOVE #1,EOT⓪(SUB.L D1,D0 ; die übrigen Byte nicht laden⓪(BCC NOEOF⓪(CLR.L D0 ; Wir sind schon längst am Ende !⓪ noEof TST.L D0⓪(BEQ noRd⓪(MOVE.L tfile,(A3)+⓪(MOVE.L A0,(A3)+ ; Pufferadr.⓪(MOVE.L D0,(A3)+⓪(MOVE.L #byread,(A3)+⓪(JSR ReadBytes⓪(MOVE.L tfile,(A3)+⓪(JSR State⓪(MOVE -(A3),D0⓪(EXT.L D0⓪(BMI noRd⓪(MOVE.L byread,D0⓪ noRd MOVE.L (A7)+,D1⓪(TST.L D0⓪&END⓪ END Fread;⓪ ⓪ ⓪ PROCEDURE GetNextLine;⓪((* Setzt A2 auf nächsten Zeilenanfang, am Textende zeigt A2 auf EOF *)⓪"BEGIN⓪$ASSEMBLER⓪(MOVEM.L D1/D2/A0/A1/A3,-(A7)⓪(MOVE.L singleLineProc,A0⓪(MOVE.L EvalStk,A3⓪(JSR (A0)⓪(MOVE.L -(A3),A2⓪(ADDQ.L #1,TextOffset ; hochzählen, um Änderung zu kennzeichnen⓪(MOVEM.L (A7)+,D1/D2/A0/A1/A3⓪$END⓪"END GetNextLine;⓪ ⓪ ⓪ PROCEDURE open;⓪ ⓪#(* Textfile oeffnen und erste Blocks einlesen,⓪&Name steht auf fnstack; setzt STARTBLK.⓪&Setzt Modula-Umgebung voraus!⓪&⓪&Setzt a2 := bufferStart⓪&⓪&D0 = "Print FileName to Screen"⓪&Ergebnis: D0 # 0 --> not found *)⓪ ⓪ BEGIN ASSEMBLER⓪*MOVE.W D0,isInclude⓪*LEA currentText,A5⓪*JSR GETFN⓪(END;⓪(paths:= SrcPaths;⓪(SearchFile (currenttext,paths,fromStart,foundit,currentText);⓪(fnStack [fnSp] := currentText;⓪(IF isInclude THEN⓪*writeln; writestring ('File ');⓪*writestring (currentText); Write (' ')⓪(END;⓪(Files.Open (tfile,currenttext, readOnly);⓪(IOResult := State(tfile);⓪(IF IOresult = 0 THEN⓪*FastStrings.Assign (currentText, TextName);⓪*flen := FileSize (tfile);⓪*IOResult := State(tfile)⓪(END;⓪(ASSEMBLER⓪(TST.W IORESULT⓪(BMI.L ERR0⓪(CLR STARTBLK⓪(MOVEQ #3,D0 ;alle drei Drittel lesen⓪(MOVE.L bufferStart,A0⓪(ADDQ.L #2,A0⓪(JSR Fread⓪(MOVE.L D0,D1⓪(BMI freadnok⓪(CLR D0⓪!freadnok⓪(MOVE D0,IOResult⓪(BMI Err0⓪(MOVE.L bufferStart,A0⓪(MOVE.B #EOF,2(A0,D1.W)⓪(TST EOT⓪(BEQ NoEOF⓪(JSR CLOSE⓪ !NOEOF MOVE.L bufferStart,A2⓪(MOVE.B #cr,(A2)⓪(MOVE.B #lf,1(A2)⓪(CLR.W D0⓪(RTS⓪ !ERR0 MOVEQ #1,D0⓪&END⓪ END open;⓪ ⓪ ⓪ VAR question: String; (* Parameter fuer OpFile *)⓪*SerVar: Cardinal;⓪ ⓪ PROCEDURE OpFile;⓪ ⓪"(* TextNamen erfragen und File oeffnen,⓪%setzt Modula-Umgebung voraus *)⓪ ⓪ BEGIN⓪"ASSEMBLER⓪*BRA cont⓪$ser DC.W SerLead0, SerVal0 ;Seriennummer muß immer hinter⓪$cont MOVE.W ser+2(pc),SerVar ; der SerLead-Kennung stehen!⓪"END;⓪ ⓪"OpenError := FALSE;⓪"LineBuf:= ''; questVol:= FALSE;⓪ ⓪"Write (27C); Write (5C); (* Ctrl-E: Enhanced Output *)⓪"WriteString('Modula-2 Compiler ');⓪"writeLCard (CompilerVersion, 0);⓪"Write ('.');⓪"writeLCard (CompilerSubVersion, 0);⓪"IF LENGTH (internalVersion) > 0 THEN⓪$WriteString(internalVersion);⓪"END;⓪"(*$?~MAC: WriteString(' for Atari ST/TT'); *)⓪"(*$? MAC: WriteString(' for Apple Macintosh'); *)⓪"WriteString(' / Serial no. ');⓪"WriteString (CardToStr (SerVar, 0));⓪"WriteLn;⓪"(*$? Asm20:⓪$WriteString('Including 68020 & 68881 Assembler');⓪$WriteLn;⓪"*)⓪"WriteString('Copyright © [1985..1994] Jürgen Müller, Thomas Tempelmann');⓪"WriteLn;⓪ ⓪"ASSEMBLER⓪$CLR.W TxtLine ;Zeile innerhalb des Textfiles⓪$CLR.L TextOffset ;Offset innerhalb des Textfiles⓪"END;⓪ ⓪"REPEAT⓪$FastStrings.Assign (comlin^, LineBuf);⓪$StripOptions (LineBuf, FALSE);⓪$IF OpenError OR (Length (LineBuf)=0) OR ForceAsk THEN⓪&IF NOT questVol THEN⓪(WriteLn;⓪(questVol:= TRUE;⓪&END;⓪&WriteString(question);⓪&Write (27C); Write (6C); (* Ctrl-F: Enhanced Output off *)⓪&ReadString(LineBuf);⓪&WriteLn;⓪&Write (27C); Write (5C); (* Ctrl-E: Enhanced Output *)⓪&IF length (LineBuf) = 0 THEN⓪(TermProcess (1)⓪&END;⓪&StripOptions (LineBuf, FALSE);⓪$END;⓪$Strings.EatSpaces (LineBuf);⓪$FastStrings.Assign (LineBuf,fnStack [fnSp]);⓪$IF fileMode THEN⓪&ASSEMBLER⓪(CLR.W D0 ;hier bitte keinen FileName ausgeben⓪(JSR OPEN⓪(MOVE.L A2,txtPtr ;A2 zeigt auf TextAnfang⓪(MOVE.W D0,OpenError⓪&END;⓪$ELSE⓪&FastStrings.Assign (LineBuf, TextName);⓪&IF singleLineMode THEN⓪(ASSEMBLER⓪0JSR GetNextLine⓪ ⓪0; aus HandleCR:⓪0ADDQ.W #1,txtLINE ;ZEILEN im akt. Text ZAEHLEN⓪0MOVE.L A2,pTxtLin⓪0⓪0MOVE.L A2,txtPtr ;A2 zeigt auf TextAnfang⓪0MOVE #1,EOT⓪0CLR OpenError⓪(END⓪&ELSE⓪(ASSEMBLER⓪0MOVE.L bufferStart,A2⓪0⓪0; aus HandleCR:⓪0ADDQ.W #1,txtLINE ;ZEILEN im akt. Text ZAEHLEN⓪0MOVE.L A2,pTxtLin⓪0⓪0MOVE.L A2,txtPtr ;A2 zeigt auf TextAnfang⓪0MOVE #1,EOT⓪0CLR OpenError⓪(END⓪&END⓪$END;⓪"UNTIL NOT OpenError OR NOT doOutput;⓪"FileNames.SplitPath ( TextName, srcVolume, c2name(*dummy*) );⓪"IF outoptstr[0] # '' THEN⓪$WriteLn;⓪$WriteString ('Directives:');⓪$WriteString (outoptstr);⓪$WriteLn;⓪"END⓪ END OpFile;⓪ ⓪ ⓪ PROCEDURE GetSourceName;⓪"(* Source-FileName und Destination Volume holen *)⓪ BEGIN ASSEMBLER⓪*MOVEM.L D1-A1/A3-A6,-(A7)⓪*MOVE.L EVALSTK,A3⓪(END;⓪(question := ' Compile which text? ';⓪(OpFile;⓪(ForceAsk:= TRUE;⓪(WriteLn;⓪(WriteString ('Compiling '); WriteString (currenttext); WriteLn;⓪(Write (27C); Write (6C); (* Ctrl-F: Enhanced Output off *)⓪(ASSEMBLER⓪*MOVE.L A3,EVALSTK⓪*MOVE.L txtPtr,A2⓪*MOVEM.L (A7)+,D1-A1/A3-A6⓪(END⓪ END GetSourceName;⓪ ⓪ ⓪ PROCEDURE GetSearchName;⓪"⓪"(* FileName fuer Runtime-Fehlersuche holen *)⓪ ⓪ BEGIN ASSEMBLER⓪*MOVEM.L D1-A1/A3-A6,-(A7)⓪*MOVE.L EVALSTK,A3⓪(END;⓪(question := ' Scan which text? ';⓪(OpFile;⓪(ForceAsk:= TRUE;⓪(WriteLn;⓪(WriteString ('Scanning '); WriteString (currenttext); WriteLn;⓪(Write (27C); Write (6C); (* Ctrl-F: Enhanced Output off *)⓪(ASSEMBLER⓪*MOVE.L A3,EVALSTK⓪*MOVE.L txtPtr,A2⓪*MOVEM.L (A7)+,D1-A1/A3-A6⓪(END⓪ END GetSearchName;⓪ ⓪ ⓪ PROCEDURE csave;⓪"(* Save Codefile; Name ist auf ID-Stack. *)⓪ BEGIN ASSEMBLER⓪(MOVE.L Header,D0⓪(SUBQ.L #8,D0 ; wegen "MM2Code" davor⓪(MOVE.L D0,CODEBEG⓪(MOVE.L A4,D1⓪(SUB.L D0,D1⓪(MOVE.L D1,csize⓪(MOVE.L A4,CODEEND⓪(MOVEM.L D2-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪(; cname (Dateiname) erstellen⓪(MOVE.W IPFLAG,D5 ;Modul-Typ⓪(ORI #$8000,D5 ;$E-Option zulassen⓪(LEA cname,A5⓪(JSR MAKENAME2⓪(⓪(; ShellMsg.ModuleName erstellen⓪(CLR D5 ; kein Suffix⓪(LEA ModuleName,A5⓪(JSR MAKENAME2⓪(⓪(END;⓪(IF doOutput AND questVol THEN⓪*WriteLn;⓪*WriteString ('Output-volume? ');⓪*ReadString (outVol)⓪(END;⓪(IF outVol[0] = 0C THEN⓪*CASE ipflag OF⓪,1: tmpOutVol:= modVolume|⓪,2: tmpOutVol:= implVolume|⓪,3: tmpOutVol:= defnVolume⓪*END⓪(ELSE⓪*tmpOutVol:= outVol⓪(END;⓪(FileNames.ValidatePath (tmpOutVol);⓪(IF tmpOutVol[0] = 0C THEN⓪*FastStrings.Assign (srcVolume, tmpOutVol);⓪*(*⓪,IF tmpOutVol[0] = 0C THEN⓪.tmpOutVol:= '?' (* Damit wird dann der Fileselektor aufgerufen *)⓪,END⓪**)⓪(END;⓪(FastStrings.Insert (tmpOutVol, 0, cname);⓪(MakeFullName (cname,FALSE,strval);⓪(WriteLn;⓪(WriteString ('Writing to file: ');⓪(WriteString (cname);⓪(WriteLn;⓪(Files.Create (dfile,cname,writeOnly,replaceOld);⓪(IOResult := State (dfile);⓪(ASSEMBLER⓪(TST.W IORESULT⓪(BMI ERR0⓪(⓪(MOVE.L dfile,(A3)+ ;File-Ptr⓪(MOVE.L CODEBEG,A0⓪(MOVE.L codeend,D0⓪(SUB.L A0,D0 ;Laenge in bytes⓪(MOVE.L A0,(A3)+⓪(MOVE.L D0,(A3)+⓪(JSR writeBytes⓪(MOVE.L dfile,(A3)+ ;File-Ptr⓪(JSR State⓪(MOVE.W -(A3),D0⓪(MOVE D0,IOResult⓪(BMI ERR0⓪(⓪(MOVE.L #dfile,(A3)+⓪(JSR Files.close⓪(MOVE.L dfile,(A3)+ ;File-Ptr⓪(JSR State⓪(MOVE -(A3),IOResult⓪(⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D2-A6⓪(TST.W IORESULT⓪(BMI ERR0⓪(RTS⓪(⓪ !ERR0 MOVE.W IOResult,-(A7)⓪(JSR CLOSE⓪(MOVE.L A3,EVALSTK⓪(MOVE.W (A7)+,IOR⓪(JMP IOERR⓪&END;⓪ END csave;⓪ ⓪ ⓪ PROCEDURE reload; (* Buffer nachladen *)⓪ BEGIN ASSEMBLER⓪(MOVE.L D0,-(A7)⓪(MOVE.L A0,-(A7)⓪ ⓪(MOVE.L bufferStart,A0⓪(ADDQ.L #2,A0⓪(; Die letzten 2 Drittel zum Beginn schieben.⓪(MOVE.W #(blocklen * 2 DIV 16) - 1,D0⓪(MOVE.L A1,-(A7)⓪(LEA blocklen(A0),A1⓪ !RL1 MOVE.L (A1)+,(A0)+⓪(MOVE.L (A1)+,(A0)+⓪(MOVE.L (A1)+,(A0)+⓪(MOVE.L (A1)+,(A0)+⓪(DBF D0,RL1⓪(MOVE.L (A7)+,A1⓪(MOVE.L #blocklen,D1⓪(ADD.L D1,TextOffset⓪(SUBA.L D1,A2⓪(SUB.L D1,pTxtMne ; Text-Pointer für den Assembler⓪(SUB.L D1,pTxtOp1⓪(SUB.L D1,pTxtOp2⓪(SUB.L D1,pTxtOp3⓪(SUB.L D1,pTxtLin⓪(SUB.L D1,pTxtLin2⓪(SUB.L D1,pLastSym⓪(MOVE.L LINEPTR,D0⓪(BEQ RL3⓪(SUB.L D1,D0⓪(MOVE.L D0,LINEPTR⓪ !RL3⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪ ⓪(ADDQ.W #1,STARTBLK⓪(MOVEQ #1,D0 ;ein Drittel lesen⓪(MOVE.L bufferStart,A0⓪(ADDA.W #(blocklen*2)+2,A0⓪(JSR Fread⓪(BMI freadnok⓪(MOVE D0,D1⓪(CLR D0⓪#freadnok⓪(MOVE D0,IOResult⓪(MOVE.L bufferStart,A0⓪(ADDA.W #(blocklen*2)+2,A0⓪(MOVE.B #EOF,0(A0,D1.W)⓪(⓪(TST EOT⓪(BEQ notEof⓪(MOVE IOResult,-(A7)⓪(JSR CLOSE⓪(MOVE (A7)+,IOResult⓪ !NOTEOF MOVEM.L (A7)+,D1-A6⓪(MOVE.L (A7)+,A0⓪(MOVE.L (A7)+,D0⓪(TST IOResult⓪(BPL ok⓪(MOVE.W IORESULT,IOR⓪(JMP IOERR⓪ ok⓪&END⓪ END reload;⓪ ⓪ ⓪ PROCEDURE exclude;⓪#(* Include-Option beenden *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪(TST.W fileMode⓪(BEQ closed⓪(MOVE.L #tfile,(A3)+⓪(JSR Files.close⓪(MOVE.L tfile,(A3)+⓪(JSR State⓪(MOVE -(A3),IOResult⓪(BMI.L ERR0⓪ closed SUBQ.W #1,INCLEVEL⓪(BPL OK⓪(TST.W ENDMOD ;bereits Modul-Ende gefunden?⓪(BNE E⓪(MOVE.L bufferStart,A2⓪(ADDQ.L #2,A2 ;Fehlerposition wenigstens in den Text setzen⓪(MOVE #rEOInp,D5⓪(JMP SYNTAXERR ;'unexpected end of input'⓪ !E NOT.W ENDTEXT⓪(BRA.L DONE⓪ !OK JSR PULLFN ;Namen des beendeten Files vergessen⓪(LEA currentText,A5⓪(JSR GETFN⓪(JSR PullLineNo⓪&END;⓪&FastStrings.Assign (currentText, TextName);⓪&writeln; writestring ('File '); writestring (currentText); Write (' ');⓪&Files.Open (tfile,currenttext, readOnly);⓪&IOResult := State(tfile);⓪&IF IOresult = 0 THEN⓪(flen := FileSize (tfile);⓪(IOResult := State(tfile)⓪&END;⓪&ASSEMBLER⓪(TST.W IORESULT⓪(BMI.L ERR0⓪(⓪(MOVE.L tfile,(A3)+⓪(MOVE.L INCLPTR,A0⓪(MOVE.W (A0),D0 ;Rel. Block ('StartBlk')⓪(MULU #blocklen,D0⓪(MOVE.L D0,(A3)+⓪(CLR (A3)+⓪(JSR Seek⓪(MOVE.L tfile,(A3)+⓪(JSR State⓪(MOVE -(A3),IOResult⓪(BMI.L ERR0⓪(⓪(MOVE.L INCLPTR,A0⓪(MOVE.W (A0)+,STARTBLK⓪(MOVE.L bufferStart,A2⓪(ADDQ.L #2,A2⓪(ADDA.W (A0)+,A2⓪(MOVE.L A2,TXTPTR⓪(MOVE.L A0,INCLPTR⓪(MOVEQ #3,D0 ;alle drei Drittel lesen⓪(MOVE.L bufferStart,A0⓪(ADDQ.L #2,A0⓪(JSR Fread⓪(BMI ERR2⓪(MOVE.L bufferStart,A0⓪(MOVE.B #EOF,2(A0,D0.W)⓪(CLR IOResult⓪(⓪(TST EOT⓪(BEQ done⓪(JSR CLOSE⓪ !DONE MOVEM.L (A7)+,D1-A6⓪(MOVE.L TXTPTR,A2⓪(RTS⓪ !ERR2 MOVE.W D0,IORESULT⓪ !ERR0 MOVE.W IORESULT,IOR⓪(JSR CLOSE⓪(MOVEM.L (A7)+,D1-A6⓪(JMP IOERR⓪&END⓪ END exclude;⓪ ⓪ ⓪ PROCEDURE LoadDef;⓪"(*⓪#* ----------------------------------⓪#* Definitions-Modul laden, Format pruefen⓪#* ----------------------------------⓪#*⓪#* (D0-D5)⓪#*⓪#* TOId = Modul-Name, bleibt da!⓪#* Dadr = Lade-Adresse⓪#*⓪#* A0 := StartAdr des Moduls⓪#* Zero-Flag := "Modul gefunden"⓪#*)⓪ BEGIN ASSEMBLER⓪)MOVEM.L D1-A6,-(A7)⓪)MOVE.L EVALSTK,A3⓪)MOVEQ #3,D5 ;DefMod Suffix⓪)LEA cname,A5⓪)JSR MakeName2⓪'END;⓪'ASSEMBLER⓪)MOVE.L options,D0⓪)BTST #17,D0⓪)BNE.L quiet3⓪)END;⓪+Write (27C); Write (5C); (* Ctrl-E: Enhanced Output *)⓪+writeln;⓪+writestring ('Importing ');⓪)ASSEMBLER⓪'!quiet3⓪'END;⓪'⓪'lib:= FALSE; flen2:= 0;⓪'IF usesVolume[0] # 0C THEN (* $U-Option aktiv *)⓪)FileNames.ValidatePath (usesVolume);⓪)FileNames.ConcatPath(usesVolume,cname,c2name);⓪)MakeFullName (c2name,TRUE,strval);⓪)Files.Open (dfile,c2name, readOnly);⓪)IOResult := State(dfile);⓪)IF IOresult = 0 THEN⓪+ASSEMBLER⓪-MOVE.L options,D0⓪-BTST #17,D0⓪-BNE.L quiet⓪-END;⓪/writestring (c2name);⓪/Write (27C); Write (6C); (* Ctrl-F: Enhanced Output off *)⓪-ASSEMBLER⓪+!quiet⓪+END;⓪+flen2 := FileSize (dfile);⓪)END;⓪'END;⓪'⓪'IF flen2 = 0L THEN⓪ ⓪)LibFiles.LookUp (deflib, cname, libentry, IOResult);⓪)IF IOResult >= 0 THEN⓪+lib:= TRUE;⓪+flen2:= libentry.size;⓪+Seek (deflib.f, libentry.start, fromBegin);⓪+IOResult := State(deflib.f);⓪+dfile:= File (NIL);⓪+ASSEMBLER⓪-MOVE.L options,D0⓪-BTST #17,D0⓪-BNE.L quiet2⓪-END;⓪/WriteString (libname);⓪/Write (':');⓪/writestring (libentry.name);⓪/Write (27C); Write (6C); (* Ctrl-F: Enhanced Output off *)⓪-ASSEMBLER⓪+!quiet2⓪+END;⓪)ELSE⓪)⓪+paths:= DefPaths;⓪+SearchFile (cname,paths,fromStart,foundit,cname);⓪+ASSEMBLER⓪-MOVE.L options,D0⓪-BTST #17,D0⓪-BNE.L quiet4⓪-END;⓪/writestring (cname);⓪/Write (27C); Write (6C); (* Ctrl-F: Enhanced Output off *)⓪-ASSEMBLER⓪+!quiet4⓪+END;⓪+Files.Open (dfile,cname, readOnly);⓪+IOResult := State(dfile);⓪+IF IOresult = 0 THEN⓪-flen2 := FileSize (dfile);⓪+END;⓪)END;⓪'END; (* IF flen2 > 0 *)⓪ ⓪'ASSEMBLER⓪)TST.W IORESULT⓪)BMI.L error0⓪ ⓪)MOVE.L dfile,-(A7)⓪)TST lib⓪)BEQ notlib⓪)LEA deflib,A0⓪)MOVE.L deflib.f(A0),(A7)⓪'notlib⓪)MOVE.L (A7),(A3)+⓪)MOVE.L flen2,D0⓪)ADD.L DADR,D0⓪)MOVE.L D0,DEND ;EndAdr des DefModuls⓪)MOVE.L DADR,(A3)+ ;Buffer Address⓪)MOVE.L flen2,(A3)+⓪)MOVE.L #byread,(A3)+⓪)JSR ReadBytes⓪)MOVE.L (A7)+,(A3)+⓪)JSR State⓪)MOVE -(A3),D0⓪)EXT.L D0⓪)BMI freadnok⓪'freadok⓪)CLR D0⓪'freadnok⓪)MOVE D0,IOResult⓪)MOVE.W IORESULT,IOR⓪ ⓪)TST lib⓪)BNE noclose⓪)MOVE.L #DFILE,(A3)+⓪)JSR Files.close⓪'noclose⓪)MOVEM.L (A7)+,D1-A6⓪ ⓪)TST.W IOR⓪)BMI.L ende1⓪ ⓪)MOVE.L A1,D0⓪)ADD.L TRESPC,D0⓪)SUBI.L #$800,D0 ;noch Platz unterm Baum?⓪)CMP.L DEND,D0⓪)BGT OK1⓪ ⓪ errImpOv MOVE #rImpOv,D5⓪)JMP SYNTAXERR ; Fehler: kein Platz mehr zum Importieren⓪ ⓪); geladenes DefMod prüfen⓪ ⓪ !OK1 MOVE.L DADR,A0⓪)CMPI.L #$4D4D3243,(A0)+ ; "MM2C"⓪)BNE.W noDefMod⓪)CMPI.L #$6F6D7000,(A0)+ ; "omp"⓪)BNE.W noCompr⓪ ⓪); Modul dekomprimieren⓪ ⓪)MOVEM.L D1-A6,-(A7)⓪)MOVE.L EVALSTK,A3⓪)END;⓪+Compressions.GetInfo (dadr+8L, i, flen3);⓪)ASSEMBLER⓪)MOVEM.L (A7)+,D1-A6⓪ ⓪)MOVE.L A1,D1⓪)ADD.L TRESPC,D1⓪)SUBI.L #$800,D1 ;noch Platz unterm Baum?⓪)MOVE.L DEND,D0⓪)ADD.L flen3,D0⓪)CMP.L D0,D1⓪)BLS errImpOv⓪ ⓪)MOVEM.L D1-A6,-(A7)⓪)MOVE.L EVALSTK,A3⓪)⓪'again⓪)END;⓪+Compressions.Decode (dadr+8L, flen2-8L, dend, flen3, strVal);⓪+ASSEMBLER⓪0MOVE.W D1,strPos⓪+END;⓪+IF strVal THEN⓪-Copy (dend, flen3, dadr);⓪+ELSE⓪-IF strPos = 1 THEN⓪/BadId:= 'Decode: Speicher?!';⓪-ELSIF strPos = 2 THEN⓪/BadId:= 'Decode: Format?!';⓪-ELSIF strPos = 3 THEN⓪/BadId:= 'Decode: Länge?!';⓪-ELSIF strPos = 4 THEN⓪/BadId:= 'Decode: Kennung?!';⓪-ELSE⓪/BadId:= 'Decode?!';⓪-END;⓪-ASSEMBLER⓪1MOVE #rIntEr,D5⓪1JMP SYNTAXERR⓪-END⓪+END;⓪)ASSEMBLER⓪)MOVEM.L (A7)+,D1-A6⓪)TST strVal⓪)BEQ.W noDefMod⓪ ⓪)MOVE.L flen3,D0⓪)ADD.L DADR,D0⓪)MOVE.L D0,DEND ;EndAdr des DefModuls⓪ ⓪)MOVE.L A1,D1⓪)ADD.L TRESPC,D1⓪)SUBI.L #$800,D1 ;noch Platz unterm Baum?⓪)CMP.L D0,D1⓪)BLS errImpOv⓪ ⓪ noCompr MOVE.L DADR,A0⓪)CMPI.L #$4D4D3243,(A0)+ ; "MM2C"⓪)BNE noDefMod⓪)CMPI.L #$6F646500,(A0)+ ; "ode"⓪)BNE noDefMod⓪)MOVE.B 1(A0),D0⓪)ANDI.B #$F,D0⓪)CMPI.B #3,D0 ;DefMod?⓪)BEQ OK2⓪ noDefMod MOVE #rBdFrm,D5⓪)JMP SYNTAXERR⓪ !OK2 CMPI.B #5,(A0) ;(DLAYOUT) aktuelles DefMod-Format?⓪)BCC OK5⓪)MOVE #rBdLay,D5⓪)JMP SYNTAXERR⓪ ok5 MOVEM.L A0/A5,-(A7)⓪)MOVE.L A0,A5 ;Zeiger auf Namensfeld bereitstellen⓪)ADDA.L 22(A0),A5⓪)JSR LookID ;Name des DefMod aus IMPORT-Anweisung⓪)MOVE.L Options,D3⓪ CheckId1 MOVE.B (A0)+,D0⓪)MOVE.B (A5),D1⓪)EOR.B D0,D1⓪)BEQ CheckOk⓪)BTST #3,D3⓪)BNE diff ;Case Sensitive⓪)AND.B #$DF,D1⓪)BNE diff ;Abweichung⓪ CheckOk OR.B (A5)+,D0⓪)BNE CheckId1⓪)MOVEM.L (A7)+,A0/A5⓪)BRA ende1⓪ diff MOVEM.L (A7)+,A0/A5⓪)RTS⓪ ⓪ error0 ;Fehlerausgang bei IO-Error⓪)MOVEM.L (A7)+,D1-A6⓪ ende1⓪"END⓪ END LOADDEF;⓪ ⓪ ⓪ PROCEDURE include;⓪#(* Include-Option ausfuehren *)⓪ BEGIN ASSEMBLER⓪*TST.W fileMode⓪*BNE ok2⓪*MOVE.L EVALSTK,A3⓪*MOVE #4,(A3)+⓪*JMP TermProcess⓪ ok2 ADDQ.W #1,INCLEVEL⓪*CMPI.W #15,INCLEVEL ;OUT OF STACK SPACE?⓪*BLS OK⓪*MOVE #rIncOv,D5⓪*JMP SYNTAXERR⓪ !OK MOVE.L INCLPTR,A0 ;INCL STACK PTR⓪*MOVE.L A2,D0⓪*SUB.L bufferStart,D0⓪*SUBQ.L #2,D0⓪*MOVE.L D0,D1⓪*DIVU #BLOCKLEN,D1⓪*ADD.W STARTBLK,D1 ;jetzt aktueller Block⓪*MOVE.W D1,D0⓪*SWAP D1 ;Byte-Offset im Block⓪*MOVE.W D1,-(A0)⓪*MOVE.W D0,-(A0)⓪*MOVE.L A0,INCLPTR⓪*MOVEM.L D1-A1/A3-A6,-(A7)⓪*MOVE.L EVALSTK,A3⓪*JSR CLOSE ;TextFile schliessen⓪*MOVEQ #1,D0 ;mit Ausgabe des FileName⓪*JSR OPEN ;neues TextFile oeffnen⓪*MOVE.L A3,EVALSTK⓪*MOVEM.L (A7)+,D1-A1/A3-A6⓪*TST.W D0⓪*BNE ERR0⓪*JMP PushLineNo⓪ !ERR0 MOVE.W IORESULT,IOR⓪*JMP IOERR⓪(END⓪ END Include;⓪ ⓪ PROCEDURE OpenProt;⓪"(* ProtokollFile eroeffnen *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪&END;⓪&ReplaceHome (pname);⓪&Files.Create (pfile, pname, writeSeqTxt, replaceOld);⓪&IF State (pfile) # 0 THEN⓪(ProtFile := false;⓪&ELSE⓪(Now:= CurrentTime();⓪(Today:= CurrentDate();⓪(Text.Writestring (pfile, 'Modula-2 Compiler');⓪((*$? Asm20:⓪*Text.Writestring (pfile, '/ 68020 & 68881 Assembler');⓪(*)⓪(Text.Writestring (pfile, version);⓪(Text.Writestring (pfile, ' for Atari ST/TT');⓪(Text.Writestring (pfile, ' ');⓪(TimeConvert.DateToText (Today,'',nowStr);⓪(Text.Writestring (pfile, nowstr);⓪(Text.Writestring (pfile, ' ');⓪(TimeConvert.TimeToText (Now,'',nowStr);⓪(Text.Writestring (pfile, nowstr);⓪(Text.Writeln (pfile); Text.Writeln (pfile);⓪(Protfile := true⓪&END;⓪&ASSEMBLER⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END OpenProt;⓪ ⓪ ⓪ PROCEDURE CloseProt;⓪"(* ProtokollFile schliessen *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪&END;⓪&IF ProtFile THEN⓪(Files.Close (pfile);⓪(ProtFile := false;⓪&END;⓪&ASSEMBLER⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END CloseProt;⓪ ⓪ ⓪ PROCEDURE ProtLine;⓪"(* Zeile ins ProtokollFile uebernehmen⓪"⓪%A2 = ^Textzeile⓪%D0 = rel. Adresse im CodeFile (0 = keine gueltige Adr)⓪*⓪%(A0,D0) *)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L D0,RelAdr⓪(MOVE.L EVALSTK,A3⓪(LEA LineBuf,A5⓪(MOVE #txtLSize-1,D1 ; SIZE (LineBuf) !!!⓪ !lp MOVE.B (A2)+,D0 ;TextZeile in String uebernehmen⓪(BNE notnull⓪(TST.W singleLineMode⓪(BEQ lp⓪(BRA ende⓪ lpdle MOVEQ #0,D0⓪(MOVE.B (A2)+,D0⓪(SUBI.B #$21,D0⓪(BCS lp⓪ lpdl2 MOVE.B #' ',(A5)+⓪(DBRA D0,lpdl2⓪(BRA lp⓪ notnull CMP.B #lf,D0⓪(BEQ lp⓪(CMP.B #cr,D0⓪(BEQ ende⓪(CMP.B #eof,D0⓪(BEQ ende⓪(CMP.B #dle,D0⓪(BEQ lpdle⓪(MOVE.B D0,(A5)+⓪(DBRA D1,lp⓪(BRA ende0⓪ !ende CLR.B (A5)+⓪ ende0⓪&END;⓪&NumberIO.Writecard (pfile, line, 5);⓪&NumberIO.Writecard (pfile, global, 3);⓪&IF RelAdr # 0L THEN⓪(Text.Writestring (pfile, ' ');⓪(Text.WriteString (pfile, LHexToStr( reladr, 6) );⓪(Text.Writestring (pfile, ' ');⓪&ELSE⓪(Text.Writestring (pfile, ' D ');⓪&END;⓪&Text.Writestring (pfile, cop (LineBuf, 0, pcolumns-20));⓪&Text.Writeln (pfile);⓪&WHILE length (LineBuf) > pcolumns-20 DO⓪(LineBuf := cop (LineBuf, pcolumns-20, 255);⓪(Text.Writestring (pfile, ' ');⓪(Text.Writestring (pfile, cop (LineBuf, 0, pcolumns-20));⓪(Text.Writeln (pfile);⓪&END;⓪&ASSEMBLER⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END ProtLine;⓪ ⓪ PROCEDURE ProtID;⓪"(* ID ins ProtokollFile schreiben⓪"⓪%A1 = ^Object-Baum⓪%D4 = ^Variablen-Eintrag⓪"*)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪(MOVEQ #1,D7⓪(LEA LineBuf,A5⓪(; Namen holen⓪ !TP1 SUBQ.L #1,D4⓪(MOVE.B -8(A1,D4.L),D0⓪(CMP.B #$FE,D0⓪(BCC TP2⓪(MOVE.B D0,(A5)+⓪(BRA TP1⓪ !TP2 CLR.B (A5)+⓪&END;⓪&Text.writestring (pfile,LineBuf);⓪&Text.writeln (pfile);⓪&ASSEMBLER⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D0-A6⓪&END⓪ END ProtID;⓪ ⓪ PROCEDURE ProtVar;⓪"(* Variable ins ProtokollFile schreiben⓪"⓪%A1 = ^Object-Baum⓪%D4 = ^Variablen-Eintrag⓪"*)⓪ BEGIN ASSEMBLER⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪(MOVEQ #1,D7⓪(MOVE.L -14(A1,D2.L),RelAdr⓪(LEA LineBuf,A5⓪(; Namen holen⓪ !TP1 SUBQ.L #1,D4⓪(MOVE.B -8(A1,D4.L),D0⓪(CMP.B #$FE,D0⓪(BCC TP2⓪(MOVE.B D0,(A5)+⓪(BRA TP1⓪ !TP2 CLR.B (A5)+⓪&END;⓪&Text.writestring (pfile,' ');⓪&Text.WriteString (pfile, LHexToStr( reladr, 6) );⓪&Text.writestring (pfile,' ');⓪&Text.writestring (pfile,LineBuf);⓪&Text.writeln (pfile);⓪&ASSEMBLER⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D0-A6⓪&END⓪ END ProtVar;⓪ ⓪ PROCEDURE ProtVarStart;⓪"BEGIN⓪$ASSEMBLER⓪(MOVEM.L D0-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪(MOVEQ #1,D7⓪$END;⓪$Text.writeln (pfile);⓪$Text.writeln (pfile);⓪$Text.writestring (pfile,'Global variables:');⓪$Text.writeln (pfile);⓪$Text.writeln (pfile);⓪$ASSEMBLER⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D0-A6⓪$END⓪ END ProtVarStart;⓪ ⓪ ⓪ PROCEDURE ClockStop;⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪&END;⓪&StopTime:= CurrentTime();⓪&IF stoptime.hour < starttime.hour THEN⓪(inc (stoptime.hour, 24)⓪&END;⓪&seconds := 3600 * (stoptime.hour - starttime.hour)⓪1+ 60 * (stoptime.minute - starttime.minute)⓪1+ (stoptime.second - starttime.second);⓪&ASSEMBLER⓪(MOVE.L A3,EVALSTK⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END ClockStop;⓪ ⓪ PROCEDURE ClockStart;⓪ ⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪&END;⓪&FastStrings.Assign (DefSfx,dnSufx);⓪&FastStrings.Assign (ImpSfx,inSufx);⓪&FastStrings.Assign (ModSfx,cnSufx);⓪&useSufx:= '';⓪&FastStrings.Assign (DefOutPath, defnVolume);⓪&FastStrings.Assign (ImpOutPath, implVolume);⓪&FastStrings.Assign (ModOutPath, modVolume);⓪&usesVolume:= '';⓪&StartTime:= CurrentTime();⓪&Today:= CurrentDate();⓪&ASSEMBLER⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END ClockStart;⓪ ⓪ ⓪ VAR ioClosed: BOOLEAN;⓪ ⓪ PROCEDURE CloseIO; (* Deinit f. CompIO, wird nach 'Comp' aufgerufen *)⓪"BEGIN⓪$ASSEMBLER⓪(SUBA.W #100,A7⓪(ADDA.W #100,A3⓪(CMPA.L A3,A7⓪(BLS ERROR⓪(CMPA.L LoSysStack,A3⓪(BCS ERROR⓪(CMPA.L HiSysStack,A7⓪(BLS OK⓪&ERROR⓪(BREAK⓪(MOVE.L LoSysStack,A3⓪(MOVE.L HiSysStack,A7⓪%OK ADDA.W #100,A7⓪(SUBA.W #100,A3⓪$END;⓪$IF ~ioClosed THEN⓪&LibFiles.CloseLib (deflib);⓪&IF doOutput THEN⓪(InOutBase.CloseWdw;⓪&END;⓪&ioClosed:= TRUE⓪$END⓪"END CloseIO;⓪ ⓪ ⓪ PROCEDURE OpenIO; (* Init f. CompIO, wird vor 'Comp' aufgerufen *)⓪"BEGIN⓪$inclevel := 0;⓪$fnsp := 0;⓪$lineNoPtr:= 0;⓪$fileMode:= TRUE;⓪$singleLineMode:= FALSE;⓪$doOutput:= TRUE;⓪$outVol:= '';⓪$pcolumns:= 999;⓪$pname:= '';⓪$ProtFile:= FALSE;⓪$FastStrings.Assign (DefLibName, libName);⓪$GetBasePageAddr (comlin);⓪$ASSEMBLER⓪(lea inclstk,a0⓪(adda.w #64,a0⓪(move.l a0,inclptr⓪(⓪(MOVE.L comlin,A0⓪(ADDA.W #128,A0⓪(CLR D0⓪(MOVE.B (A0)+,D0⓪(MOVE.L A0,comlin⓪(CLR.B 0(A0,D0.W)⓪$END;⓪$outoptstr:= '';⓪$IDStkSize:= 2048;⓪$StripOptions (comlin^, TRUE);⓪$IF fileMode THEN⓪&Allocate (bufferStart, 3 * blocklen + 4);⓪&IF bufferStart = NIL THEN⓪(TermProcess (-39) (* out of mem *)⓪&END;⓪&bufferRes:= bufferStart + 2 * blocklen + 2⓪$END;⓪$IF doOutput THEN⓪&InOutBase.OpenWdw (76,20)⓪$END;⓪$HomePath:= ShellPath;⓪$ReplaceHome (libName);⓪$Directory.MakeFullPath (libName, ior);⓪$LibFiles.OpenLib (deflib, libName, ior);⓪$wsp.bottom:= NIL;⓪$CatchProcessTerm (tCarrier, CloseIO, wsp);⓪$ioClosed:= FALSE⓪"END OpenIO;⓪ ⓪ ⓪ PROCEDURE Statistics;⓪ BEGIN ASSEMBLER⓪(MOVEM.L D1-A6,-(A7)⓪(MOVE.L EVALSTK,A3⓪&END;⓪&Text.Writeln (pfile);⓪&⓪&Text.Writestring (pfile, 'Source text length :');⓪&NumberIO.Writecard (pfile, line, 10);⓪&Text.Writestring (pfile, ' lines'); Text.Writeln (pfile);⓪&⓪&Text.Writestring (pfile, 'Code file length :');⓪&NumberIO.Writecard (pfile, csize, 10);⓪&Text.Writestring (pfile, ' bytes'); Text.Writeln (pfile);⓪&⓪&if seconds # 0 then⓪(Text.Writestring (pfile, 'Compilation time :');⓪(NumberIO.Writecard (pfile, seconds, 10);⓪(Text.Writestring (pfile, ' seconds'); Text.Writeln (pfile);⓪(⓪(Text.Writestring (pfile, 'Compilation rate :');⓪(NumberIO.Writecard (pfile, line div seconds, 10);⓪(Text.Writestring (pfile, ' lines/second'); Text.Writeln (pfile);⓪&⓪(case seconds mod 5 of⓪*0: lineBuf := 'Population of Zimbabwe : 7700000 people' |⓪*1: lineBuf := "ASH's phone number : 06221 300002" |⓪*2: lineBuf := 'Electron mass : 511 KeV' |⓪*3: lineBuf := '57862 * 851 bananas : 49240562 bananas' |⓪*4: lineBuf := 'Great movie : 2001' |⓪(end;⓪(Text.Writestring (pfile, lineBuf); Text.Writeln (pfile)⓪&end;⓪&⓪&Text.Writeln (pfile);⓪&⓪&ASSEMBLER⓪(MOVEM.L (A7)+,D1-A6⓪&END⓪ END Statistics;⓪ ə (* $0000BD59$0000A691$FFFA9829$0000A6A8$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$000035C5$FFFAB0E6$0000D7E5$FFFAB0E6$00004C4E$FFFAB0E6$FFF6B0E0$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$00009380$FFECE157$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6$FFFAB0E6Ç$00003315T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$000035DB$000035C5$00003323$00003315$0000343B$00003456$00003466$000033AE$00003449$FFE2FA4A$00003422$00003430$000034BB$000034C9$00003323$000032EBÉÇé*)